home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 17 / CU Amiga Magazine's Super CD-ROM 17 (1997)(EMAP Images)(GB)[!][issue 1997-12].iso / CUCD / Programming / Gui4Cli / Tools / Palette.gc < prev    next >
Encoding:
Gui4CLI script  |  1980-01-03  |  6.3 KB  |  214 lines
  1. G4C
  2.  
  3. ; Palette.gc by dck/J.Collett
  4.  
  5. ; A full palette gui with many capabilities
  6. ; Press CONTROL-J to make it jump screens
  7.  
  8. winbig -1 -1 235 120 'Palette'
  9. wintype 11110001
  10. varpath ''                ; we only need our private vars
  11.  
  12. box 0 0 0 0 out icondrop
  13.  
  14. xonload
  15. guiopen palette.gc
  16. info palette palette.gc/5        ; get info on *our* platte
  17. setvar type 'update'
  18. gosub palette.gc update                 ; Subroutine
  19.  
  20. xonRMB        ; on rmb we update to the color under mouse position
  21. update palette.gc 5 $$mouse.color
  22. gosub palette.gc update        ; did not choose the color by clicking it
  23.  
  24.  
  25. xonclose
  26. ;  ---- If Ram:Spr was created, delete it
  27. ifexists FILE Ram:Spr.rexx
  28.    delete Ram:Spr.rexx
  29. endif
  30. guiquit palette.gc
  31.  
  32. xpalette 10 5 225 30               ; This is the visible palette
  33. gadid 5
  34. gosub palette.gc $type
  35.  
  36. xHSlider 40 40 160 12 R pal.r 0 15 0 %2ld
  37. setcolor palette.gc $$color.num $pal.r $pal.g $pal.b
  38. gadid 1
  39.  
  40. xHSlider 40 52 160 12 G pal.g 0 15 0 %2ld
  41. setcolor palette.gc $$color.num $pal.r $pal.g $pal.b
  42. gadid 2
  43.  
  44. xHSlider 40 64 160 12 B pal.b 0 15 0 %2ld
  45. setcolor palette.gc $$color.num $pal.r $pal.g $pal.b
  46. gadid 3
  47.  
  48.  
  49. ; --- routine to update sliders & get variables
  50.  
  51. xRoutine update
  52. pal.r = $$color.r     ; get new values   Three colour values, the
  53.                       ; colour number, and the total number of colours.
  54. pal.g = $$color.g
  55. pal.b = $$color.b
  56. pal.n = $$color.num
  57. pal.t = $$color.total
  58. pal.or = $pal.r       ; store values for undo slider changes
  59. pal.og = $pal.g       ; original rgb values
  60. pal.ob = $pal.b
  61. update palette.gc 1 $pal.r    ; Update gads 1, 2, 3
  62. update palette.gc 2 $pal.g
  63. update palette.gc 3 $pal.b
  64. setwintitle palette.gc 'Palette color $pal.n of $pal.t'
  65.  
  66.  
  67. ; -----------> buttons to save/load etc palettes (saved as guis)
  68.  
  69. xbutton 10 85 70 14 Undo     ; undo last changes
  70. setcolor palette.gc $$color.num $pal.or $pal.og $pal.ob
  71. gosub palette.gc update
  72.  
  73.  
  74. ; ---- Load a previously saved palette (i.e. a normal GUI with setcolors)
  75. ; ---- We *must* set the variable $pal.gui to the name of our gui
  76.  
  77. xbutton  80 85 70 14 Load..
  78. pal.file = ''
  79. ReqFile -1 -1 300 200 'Load Palette:' LOAD pal.file 'GUIs:tools/palette'
  80. if $pal.file = ''
  81.    stop
  82. endif
  83. *pal.gui = palette.gc        ; set pal.gui as a GLOBAL variable
  84. guiload $pal.file        ; load the gui
  85. delvar *pal.gui            ; delete pal.gui as we don't need it
  86. update palette.gc 5 1        ; go back to color No 1
  87. info palette palette.gc/5    ; get info on palette
  88. gosub palette.gc update        ; redraw the sliders etc
  89.  
  90.  
  91. ; ---- saving : make a loop and write a gui to set all colors
  92. ;      variable pal.gui must (when loading) contain the name of the
  93. ;      gui whose screen colors will be changed.
  94.  
  95. xbutton  150 85 70 14 Save..
  96. pal.file = ''
  97. ReqFile -1 -1 300 200 'Save Palette:' SAVE pal.file ''
  98. if $pal.file = ''
  99.    stop
  100. endif
  101. guiwindow palette.gc wait
  102. setwintitle palette.gc 'Saving Palette...'
  103. info palette palette.gc/5       ; make sure we're talcking about *our* palette
  104. setvar .palette 'G4C\n\n;Palette\n\nxOnLoad\n'
  105. pal.count = 0
  106. while $pal.count < $pal.t
  107.     update palette.gc 5 $pal.count  ; update the palette to next color
  108.     append env:.palette 'setcolor \$pal.gui $pal.count $$color.r $$color.g $$color.b\n'
  109.     counter pal.count inc 1 
  110. endwhile
  111. extract pal.file file pal.filename
  112. append env:.palette 'guiquit $pal.filename\n'
  113. copy env:.palette $pal.file
  114. delete env:.palette
  115. guiwindow palette.gc resume
  116. update palette.gc 5 1
  117. info palette palette.gc/5
  118. gosub palette.gc update
  119.  
  120. ; ---- JC's additions below this line : Copy, Exchange, Spread
  121.  
  122. xbutton  10 100 70 14 Copy
  123. setvar type 'copy'
  124.  
  125. xbutton  80 100 70 14 Exchange
  126. setvar type 'exchange'
  127.  
  128. xbutton  150 100 70 14 Spread
  129. setvar type 'spread'
  130.  
  131. ; --- routine to copy values
  132.  
  133. xRoutine copy
  134. pal.on = $pal.n       ; Store existing colour number
  135. pal.r = $$color.r     ; get new values  
  136. pal.g = $$color.g
  137. pal.b = $$color.b
  138. pal.n = $$color.num
  139. ;Set new colour to old values
  140. setcolor palette.gc $pal.n  $pal.or $pal.og $pal.ob
  141. setvar type 'update'             ; Reset routine flag
  142. ; Update window title
  143. setwintitle palette.gc 'Copied color $pal.on to $pal.n'
  144. update palette.gc 5 $pal.n
  145. gosub palette.gc update
  146.  
  147. ; --- routine to exchange values
  148.  
  149. xRoutine exchange
  150. pal.on = $pal.n       ; Store existing colour number
  151. pal.r = $$color.r     ; get new values  
  152. pal.g = $$color.g
  153. pal.b = $$color.b
  154. pal.n = $$color.num
  155. ;Set each colour to other values
  156. setcolor palette.gc $pal.n  $pal.or $pal.og $pal.ob
  157. setcolor palette.gc $pal.on  $pal.r $pal.g $pal.b
  158. setvar type 'update'             ; Reset routine flag
  159. ; Update window title
  160. setwintitle palette.gc 'Exchanged colors $pal.on and $pal.n'
  161. update palette.gc 5 $pal.n
  162. gosub palette.gc update
  163.  
  164. ; --- routine to spread values
  165.  
  166. xRoutine spread
  167. update palette.gc 5 $$color.num
  168. setvar CStore "$pal.n "
  169. appvar CStore "$$color.num "
  170. appvar CStore "$pal.or "
  171. appvar CStore "$pal.og "
  172. appvar CStore "$pal.ob "
  173. appvar CStore "$$color.r " 
  174. appvar CStore "$$color.g "
  175. appvar CStore "$$color.b"
  176. ifexists FILE Ram:Spr.rexx
  177.     ; nop
  178. else
  179.     gosub Palette.gc MakeRexx
  180.     rename env:.Spr Ram:Spr.rexx
  181. endif
  182. run 'sys:rexxc/rx Ram:Spr.rexx $CStore'
  183. setvar type 'update'             ; Reset routine flag
  184. gosub palette.gc update
  185.  
  186. ; ---- Routine to create an ARexx program to do the spreading.
  187.  
  188. xroutine MakeRexx
  189. setvar .Spr "/* */\n"
  190. append Env:.Spr "parse arg col1 col2 r1 g1 b1 r2 g2 b2 \n"
  191. append Env:.Spr "if col1 > col2 then do\n"
  192. append Env:.Spr "   n = col1 ; col1 = col2 ; col2 = n\n" 
  193. append Env:.Spr "   rn = r1 ; r1 = r2 ; r2 = rn\n" 
  194. append Env:.Spr "   gn = g1 ; g1 = g2 ; g2 = gn\n" 
  195. append Env:.Spr "   bn = b1 ; b1 = b2 ; b2 = bn ; end\n"
  196. append Env:.Spr "dif = col2 - col1 - 1\n"
  197. append Env:.Spr "rds = max(r1,r2) - min(r1,r2) - 1\n"
  198. append Env:.Spr "gds = max(g1,g2) - min(g1,g2) - 1\n"
  199. append Env:.Spr "bds = max(b1,b2) - min(b1,b2) - 1\n"
  200. append Env:.Spr "dr = sign(r2 - r1) ; dg = sign(g2 - g1)\n"
  201. append Env:.Spr "db = sign(b2 - b1)\n"
  202. append Env:.Spr "rbit = rds / dif * dr ; gbit = gds / dif * dg\n"
  203. append Env:.Spr "bbit = bds / dif * db\n"
  204. append Env:.Spr "do st = 1 to dif\n"
  205. append Env:.Spr "   r = r1 + trunc(st * rbit)\n"
  206. append Env:.Spr "   g = g1 + trunc(st * gbit)\n"
  207. append Env:.Spr "   b = b1 + trunc(st * bbit)\n"
  208. append Env:.Spr "   msg = col1 + st || ' ' r || ' ' || g || ' ' b\n"
  209. append Env:.Spr "   address 'Gui4Cli'\n"
  210. append Env:.Spr "   'SetColor Palette.gc ' msg\n"
  211. append Env:.Spr "   address\n"
  212. append Env:.Spr "   end\n"
  213. append Env:.Spr "exit\n"
  214.